perm filename M11C.FOR[ZZZ,LCS] blob
sn#439878 filedate 1979-05-08 generic text, type T, neo UTF8
CFORS3 FORTRAN UNIT GENERATOR ROUTINE *** MUSIC V ***
SUBROUTINE FORSAM
DIMENSION ENVP(27),COSP(27)
C COSP & ENVP STORE POINTERS FOR 'COS' & 'ENV' ARRAYS. SEE AT 105 FOR INFO.
COMMON /LM/L(10),M(10),NSAMX
C CAN USE UP TO 10 FIELDS IN UNIT GEN.
COMMON I(1) /P/P(1) /GENS/GENS(1) /LFUNC/LFUNC,XNFUN,PINCR
1 /XIN/AMP,FREQ
COMMON /INS/INS(1) /NT/RNT(1) /ROUT/ROUT(1)
C INS=INSTRUMENT DEFINITIONS, RNT=NOTE CARD INFO, ROUT=OUTPUT BLOCK
EQUIVALENCE(M1,M(1)),(M2,M(2)),(M3,M(3)),(M4,M(4)),(M5,M(5)),(M6,M
1(6)),(M7,M(7)),(M8,M(8)),(L1,L(1)),(L2,L(2)),(L3,L(3)),(L4,L(4)),(
2 L5,L(5)),(L6,L(6)),(L7,L(7)),(L8,L(8)),(AMP,XIN1),(FREQ,XIN2)
3 ,(I5,I(5)),(I6,I(6)),(I3,I(3)),(L9,L(9))
XNFUN=LFUNC-1
C COMMON INITIALIZATION OF GENERATORS
N1=I6+2
CCC I6 HAS POINTER TO CODE (IN INS ARRAY) FOR U.G. NOW TO BE PROCESSED.
N2=INS(N1-1)-1
DO 204 J1=N1,N2
J2=J1-N1+1
IF(INS(J1).GE.0)GO TO 201
200 L(J2)=-INS(J1)
M(J2)=1
GO TO 204
201 M(J2)=0
202 L(J2)=INS(J1)+I3-1
GO TO 204
203 L(J2)=INS(J1)-26262
204 CONTINUE
N3=INS(I6)
IF(M1.LE.0)AMP=RNT(L1)
IF(M2.LE.0)FREQ=RNT(L2)
J3= N3 -100
CPDP10 CALL INITIT(J3)
AMP=RNT(L1)
FREQ=RNT(L2)
NSAM=I5
NSAMX=NSAM-1
C OUT OSC AD2 RAI ENV STR AD3 AD4 MLT DIV RAH
GO TO (101,102,103,104,105,106,107,108,109,110,111,112,113,114,
1 115,116,117,118),J3
CC IF(NGEN.EQ.14)CALL OPT(L,M,NSAM)
C FOLLOWING IS SUGGESTED HEADER FOR SUBROUTINE OPT
C SUBROUTINE OPT(L,M,NSAM)
C DIMENSION L(8),M(8)
C COMMON /GENS/GENS(1)/LFUNC/LFUNC/NT/RNT(1)/ROUT/ROUT(1)
CC114 CALL OPT(L,M,NSAM)
114 RETURN
112 RETURN
CC113 CALL REVERB
113 RETURN
C ADD REVERB SUBROUTINE ONLY WHEN WANTED. IT NEEDS EXTRA MEMORY.
117 RETURN
C 117 WILL BE FOR 'INP', READING EXTERNAL SOUND FILES.
C UNIT GENERATORS
C OUTPUT BOX
101 DO 270 K=0,NSAMX
J5=L2+K
270 ROUT(J5)=ROUT(J5)+ROUT(K+L1)
RETURN
C OUTPUT=WHAT'S THERE ALREADY + WHAT'S COMING IN FROM THIS INST.
C THIS NEW FORM ASSUMES THE OUT BOX HAS ONLY 'Bn' AS INPUT.
C OSCILLATOR L1,L2 = P or B L3=B L4=F or P L5=P
C AMPL, TIME, OUTPUT, FUNC, 5TH NO LONGER USED.
C M1, M2 =1 = NT. =0 = ROUT (P=FIXED INPUT, B=DYNAMIC INPUT, F=FUNC.)
102 SUM=RNT(L5)
CALL LOCGEN(M4,L4)
C FINDS POINTER TO FUNC NUM. IF M4.EQ.1 THEN FNUM WAS IN INST DEF.
DO 293 J3=0,NSAMX
J4=INT(SUM)+L4
F=GENS(J4)
C GENS(J4) IS IN FUNC STORAGE AREA.
IF(M2.GT.0)GO TO 286
SUM=SUM+FREQ
GO TO 290
286 J4=L2+J3
SUM=SUM+ROUT(J4)
290 IF(SUM.GE.XNFUN)SUM=SUM-XNFUN
288 J5=L3+J3
IF(M1.GT.0)GO TO 292
ROUT(J5)=AMP*F
GO TO 293
292 J6=L1+J3
ROUT(J5)=ROUT(J6)*F
293 CONTINUE
RNT(L5)=SUM
C L5 POINTS TO NOTE ARRAY. SAVE A POINTER.
RETURN
C 118 COS = CONTINUING, NEG. OSCILLATOR (FOR LEGATO)*** CAN'T PLAY CHORDS!!!
118 L9=RNT(I3)
C GET POINTER TO INS. NUM.
SUM=COSP(L9)
C ONLY 1 COS PER INSTRUMENT AT THIS TIME*****************
GO TO 218
C NOW JUMP AND ACT LIKE A 'NOS'.
C 115 NEG OSCILLATOR L1,L2 = P or B L3=B L4=F or P L5=P
C 'NOS' AMPL, TIME, OUTPUT, FUNC, 5TH NO LONGER USED.
C M1, M2 =1 = ROUT =0 = PARM (P=FIXED INPUT, B=DYNAMIC INPUT, F=FUNC.)
115 SUM=RNT(L5)
218 CALL LOCGEN(M4,L4)
C FINDS POINTER TO FUNC NUM. IF M4.EQ.1 THEN FNUM WAS IN INST DEF.
DO 215 L7=0,NSAMX
J4=INT(SUM)+L4
F=GENS(J4)
C GENS(J4) IS IN FUNC STORAGE AREA.
IF(M2.GT.0)GO TO 915
SUM=SUM+FREQ
GO TO 315
915 J4=L2+L7
SUM=SUM+ROUT(J4)
315 IF(SUM.GE.XNFUN)GO TO 415
IF(SUM.LT.0.0)GO TO 615
715 J5=L3+L7
IF(M1.GT.0)GO TO 815
ROUT(J5)=AMP*F
GO TO 215
C**********
415 SUM=SUM-XNFUN
GO TO 715
615 SUM=SUM+XNFUN
GO TO 715
C******* ABOVE FOR FM (NEG. FREQ. TO OSCIL)
815 J6=L1+L7
ROUT(J5)=ROUT(J6)*F
215 CONTINUE
IF(J3.EQ.18)GO TO 318
C JUMP IF THIS IS 'COS' BEING PROCESSED
RNT(L5)=SUM
C L5 POINTS TO NOTE ARRAY. SAVE A POINTER.
RETURN
318 COSP(L9)=SUM
C SAVE POINTER FOR INST. L9
RETURN
C ADD TWO BOX
C LOOK AT NT ARRAY FOR FIXED VALUES, LOOK AT ROUT FOR CHANGING VALS.
103 DO 258 J3=0,NSAMX
IF(M1.GT.0)XIN1=ROUT(J3+L1)
IF(M2.GT.0)XIN2=ROUT(L2+J3)
ROUT(J3+L3)=XIN1+XIN2
258 CONTINUE
RETURN
C 116 SUBTRACT
116 DO 1016 J3=0,NSAMX
IF(M1.GT.0)XIN1=ROUT(J3+L1)
IF(M2.GT.0)XIN2=ROUT(L2+J3)
ROUT(J3+L3)=XIN1-XIN2
1016 CONTINUE
RETURN
C RANDOM INTERPOLATING GENERATOR RAI Px Py Bn Pq Pr Ps; OR RAI L1 L2 L3 L4 L5 L6;
C M1=0=Pn M1=1=Bn
104 SUM=RNT(L4)
RN1=RNT(L5)
RN3=RNT(L6)
IF(SUM.NE.0)GO TO 313
CALL RNDM(RN1)
CALL RNDM(RN3)
C INIT THE RANDOM NUMBERS.
313 DO 340 J3=0,NSAMX
IF(M1.GT.0)XIN1=ROUT(J3+L1)
IF(M2.GT.0)XIN2=ROUT(J3+L2)
IF(XNFUN.GT.SUM)GO TO 320
SUM=SUM-XNFUN
CALL RNDM(RN4)
304 RN2=RN4-RN3
RN1=RN3
RN3=RN4
GO TO 321
320 RN2=RN3-RN1
321 ROUT(J3+L3)=XIN1*(RN1+(RN2*SUM)/XNFUN)
SUM=SUM+XIN2
340 CONTINUE
RNT(L4)=SUM
RNT(L5)=RN1
RNT(L6)=RN3
RETURN
C ENVELOPE GENERATOR ENV PorB, ForP, B, P, P, P, P, P;
C AMPL FUNC OUT ATCK STDY DCAY FLAG STOR
C FLAG=1=NO CONTINUATION, REINITS FOR EACH NOTE AND CAN PLAY ON TOP OF SELF.
C FLAG=0=INIT CONTINUATION FOR SEVERAL NOTES UNDER 1 ENV.
C -1=CONTINUATION (USE DIFFERENT INS. NUMS FOR CHORDS!!)
105 L9=RNT(I3)
C GET INS. NUM.
ENVX=RNT(L7)
IF(ENVX)805,605,905
905 SUM=RNT(L8)
GO TO 705
805 SUM=ENVP(L9)
GO TO 705
605 SUM=0
RNT(L7)=-1.
705 CALL LOCGEN(M2,L2)
C FINDS POINTER TO FUNC NUM. IF M2.EQ.1 THEN FNUM WAS IN INST DEF.
XIN4=RNT(L4)
XIN5=RNT(L5)
XIN6=RNT(L6)
XIN5=PINCR/(PINCR/XIN5 - PINCR/XIN4 -PINCR/XIN6 )
C XIN5 HAS INCR. VALUE OF STEADY STATE. (IT WAS TOTAL DUR. BEFORE.)
C THESE 3 PARAMS ARE ATTACK DUR, TOTAL DUR, DECAY DUR.
C STEADY STATE TIME IS COMPUTED
XIN4=XIN4/4.
XIN5=XIN5/4.
XIN6=XIN6/4.
X1=128.
X2=256.
X3=384.
C THESE NUMBERS BASED ON USING 3/4 OF 512 ARRAY.
DO 205 J3=0,NSAMX
J4=INT(SUM)+L2
F=GENS(J4)
IF(M1.GT.0)AMP =ROUT(J3+L1)
IF(SUM.GE.384.)SUM=0
C FOR WRAP-AROUND
IF(SUM.GE.128.)GO TO 305
C JUMP IF ATTACK BOUNDRY IS PASSED.
SUM=SUM+XIN4
GO TO 405
305 IF(SUM.GE.256.)GO TO 505
C JUMP IF STEADY STATE BOUNDRY IS PASSED.
SUM=SUM+XIN5
GO TO 405
505 SUM=SUM+XIN6
405 J7=L3+J3
ROUT(J7)=AMP*F
205 CONTINUE
IF(ENVX.LE.0)GO TO 1005
RNT(L8)=SUM
RETURN
1005 ENVP(L9)=SUM
RETURN
C STEREO OUTPUT BOX L1,L2 = B L3=B1
C IT IS ASSUMED ALL INPUTS ARE 'B' TYPE.
106 NSSAM=2*NSAM
C 6/29/70 L.C.SMITH
ICT=0
DO 206 J3=1,NSSAM,2
J4=L1+ICT
XIN1=ROUT(J4)
306 J5=L3+J3-1
ROUT(J5)=XIN1+ROUT(J5)
506 J4=L2+ICT
XIN2=ROUT(J4)
406 J5=L3+J3
ROUT(J5)=XIN2+ROUT(J5)
206 ICT=ICT+1
RETURN
C ADD 3 BOX
107 IF(M3.LE.0)XIN3=RNT(L3)
DO 780 J3=0,NSAMX
IF(M1.GT.0)XIN1=ROUT(L1+J3)
IF(M2.GT.0)XIN2=ROUT(L2+J3)
IF(M3.GT.0)XIN3=ROUT(L3+J3)
ROUT(J3+L4)=XIN1+XIN2+XIN3
780 CONTINUE
RETURN
C ADD 4 BOX
108 IF(M3.LE.0)XIN3=RNT(L3)
IF(M4.LE.0)XIN4=RNT(L4)
DO 880 K=0,NSAMX
IF(M1.GT.0)XIN1=ROUT(L1+K)
859 IF(M2.GT.0)XIN2=ROUT(L2+K)
IF(M3.GT.0)XIN3=ROUT(L3+K)
863 IF(M4.GT.0)XIN4=ROUT(L4+K)
ROUT(L5+K)=XIN1+XIN2+XIN3+XIN4
880 CONTINUE
RETURN
C MULTIPLIER
109 DO 908 J3=0,NSAMX
IF(M1.GT.0)XIN1=ROUT(J3+L1)
IF(M2.GT.0)XIN2=ROUT(J3+L2)
ROUT(J3+L3)=XIN1*XIN2
908 CONTINUE
RETURN
C 110 DIVIDER
110 DO 1010 J3=0,NSAMX
IF(M1.GT.0)XIN1=ROUT(J3+L1)
IF(M2.GT.0)XIN2=ROUT(J3+L2)
1010 ROUT(J3+L3)=XIN1/XIN2
RETURN
C SET NEW FUNCTION IN OSC OR ENV
C 'SET' NO LONGER NEEDED!!!! NOW 110 CAN BE USED FOR SOMETHING ELSE.
C RANDOM AND HOLD GENERATOR RAH Px Py Bn Pq Pr; OR RAH L1 L2 L3 L4 L5;
C M1=0=Pn M1=1=Bn
111 SUM=RNT(L4)
913 RN=RNT(L5)
IF(SUM.EQ.0)CALL RNDM(RN)
C TO INIT RANDOM NUMB. (COULD THIS EVER LOSE?)
DO 940 J3=0,NSAMX
IF(M1.GT.0) XIN1=ROUT(J3+L1)
IF(M2.GT.0) XIN2=ROUT(J3+L2)
IF(XNFUN.GT.SUM)GO TO 920
SUM=SUM-XNFUN
CALL RNDM(RN)
920 ROUT(J3+L3)=XIN1*RN
SUM=SUM+XIN2
940 CONTINUE
RNT(L4)=SUM
RNT(L5)=RN
RETURN
END
SUBROUTINE RNDM(X)
COMMON /NRAN/NR1,NR2
DATA NR1/0/,NR2/0/
CPDP10 X=2.*RAN(X)-1.
X=2.*RAN(NR1,NR2)-1.
C SENDS BACK NUMBER BETWEEN -1 AND +1
END
SUBROUTINE LOCGEN(M,L)
COMMON /NT/RNT(1) /LOCG/LOCG(1)
IF(M.EQ.0)L=LOCG(INT(RNT(L)))
C GET POINTER TO START OF FUNC. ARRAY
END